home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 26
/
Cream of the Crop 26.iso
/
program
/
p063b9s.zip
/
UNIT
/
DISPLAY.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1997-01-15
|
15KB
|
468 lines
UNIT Display;
{╔══════════════════════════════════════════════════════════════════════════╗}
{║ Routines to display information Last changed: 15.01.97 SA ║}
{║ ║}
{║ (C) Copyright 1989-96 by ║}
{║ Dan Wulff, Jens Sandalgaard, Steen Christensen & S¢ren Ager ║}
{║ ║}
{║ This source may not be given to anybody, without the written permission ║}
{║ from The Portal Team. ║}
{╚══════════════════════════════════════════════════════════════════════════╝}
{$I POPDEFS.INC}
INTERFACE
USES Use32, OpWindow, ApTimer,
PoPTypes, Globals;
TYPE
PGauge=^TGauge;
TGauge=Object(StackWindow)
CONSTRUCTOR Init(y, Col: Byte; Header: S40; AMax: LongInt);
PROCEDURE Update(Num: LongInt);
PRIVATE
Max : LongInt;
END;
PWait=^TWait;
TWait=Object(StackWindow)
CurState,
Col : Byte;
Text : S80;
Timer : EventTimer;
CONSTRUCTOR Init(y, ACol: Byte; AText: S80);
PROCEDURE Animate;
END;
PROCEDURE Tell(VAR w: WindowPtr; CONST S, Header: S80; YPos, ColorLevel: Byte);
PROCEDURE ShowAbout;
PROCEDURE UpdateFrames;
PROCEDURE UpdateNetMailFlag;
FUNCTION SendableData(OutListPtr: POutList): Boolean;
PROCEDURE UpdateOutboundWindow;
FUNCTION CorrectAttribute(Level: Byte; Current, Marked: Boolean): Byte;
FUNCTION WaitForAction(Secs: LongInt): WORD;
PROCEDURE UpdateCallsWindow(w: WindowPtr; n: Byte);
PROCEDURE AboutToday;
PROCEDURE UpdateStatusWindow;
IMPLEMENTATION
USES Dos, OpFrame, OpCrt, OpDate, OpString,
Com, Keyboard,
{$IFNDEF OS2}
Macro,
{$ENDIF}
OproUtil, StrUtil, Util, MTask, OpusMsg;
{=== TGauge ===}
CONSTRUCTOR TGauge.Init(y,Col:Byte; Header:S40; AMax:LongInt);
BEGIN
IF AMax=0 THEN Fail;
INHERITED InitCustom(14,y,65,y,Cfg.Color[Col],wClear+wSaveContents+wBordered);
IF Header<>'' THEN wFrame.AddHeader(' '+Header+' ',heTC);
IF Cfg.Screen.ExplodingWin THEN EnableExplosions(10);
wFRame.AddShadow(shBR,shSeeThru);
SetCursor(cuHidden);
Draw;
Max:=AMax;
Update(0);
END;
PROCEDURE TGauge.Update(Num:LongInt);
VAR
pct:Real;
pcti:Byte;
s:S50;
FUNCTION FillTab (i:Byte): CHAR;
BEGIN
CASE i OF
0 : FillTab:=#219;
1 : FillTab:=#178;
2 : FillTab:=#177;
3 : FillTab:=#176;
END;
END;
BEGIN
ActivateWrite;
pct:=200.0*Round(Num)/Round(Max);
pcti:=Trunc(pct);
IF pcti>3 THEN s:=charstr(FillTab(3),Trunc(pcti DIV 4)) ELSE s:='';
IF Length(s)<50 THEN s:=s+FillTab(pcti mod 4)+charstr(#219,49-length(s));
wfasttext(s,1,2);
DeActivateWrite;
END;
{=== TWait ===}
CONSTRUCTOR TWait.Init(y, ACol: Byte; AText: S80);
BEGIN
INHERITED InitCustom(37-Length(AText) div 2, y, 43+Length(AText) div 2, y,
Cfg.Color[ACol], wClear+wSaveContents+wBordered);
SetCursor(cuHidden);
wFrame.AddHeader(' Please wait ',heTC);
IF Cfg.Screen.ExplodingWin THEN EnableExplosions(10);
wFrame.AddShadow(shBR, shSeeThru);
Draw;
NewTimer(Timer, -18);
Col:=ACol;
Text:=AText;
CurState:=0;
Animate;
END;
PROCEDURE TWait.Animate;
CONST
StateMax = 3;
StateChar : ARRAY[0..StateMax] of Char = ('|','/','-','\');
BEGIN
IF TimerExpired(Timer) THEN
BEGIN
wFastCenter(Text+' '+StateChar[CurState], 1, Cfg.Color[Col].TextColor);
IF CurState=StateMax THEN CurState:=0 ELSE Inc(CurState);
NewTimer(Timer, 6);
END;
END;
{=== ===}
PROCEDURE Tell(VAR w: WindowPtr; CONST S, Header: S80; YPos, ColorLevel: Byte);
BEGIN
MyWin(w,38-Length(s) div 2,YPos,42+Length(s) div 2,YPos+2, ColorLevel, Header, True);
w^.wFastText(s,1,2);
END;
PROCEDURE ShowAbout;
VAR
Start : Byte;
About : WindowPtr;
BEGIN
Start:=(ScreenHeight DIV 2)-4;
MyWin(About, 24, Start, 56, Start+8, 2, 'About', True);
WITH About^ DO
BEGIN
wFastCenter('Portal of Power',2,Cfg.Color[2].HighLightColor);
wFastCenter('Version '+Ver,3,Cfg.Color[2].TextColor);
wFastCenter('(C) Copyright 1989-97 by',5,Cfg.Color[2].TextColor);
wFastCenter('The Portal Team',6,Cfg.Color[2].TextColor);
END;
REPEAT
GiveUpTime;
UNTIL PoPKeyPressed OR ComPort^.KeyPressed;
KillWindow(About);
IF PoPKeyPressed THEN PoPReadKeyWord;
END;
PROCEDURE UpdateFrames;
BEGIN
If InLogWin Then
BEGIN
ActivityWindow^.wFrame.SetFrameType(DblWindowFrame);
OutboundWindow^.wFrame.SetFrameType(SglWindowFrame);
End Else
BEGIN
ActivityWindow^.wFrame.SetFrameType(SglWindowFrame);
OutboundWindow^.wFrame.SetFrameType(DblWindowFrame);
END;
ActivityWindow^.wFrame.UpDateFrame;
OutboundWindow^.wFrame.UpDateFrame;
{$IFNDEF OS2}
WriteMacroStatus;
{$ENDIF}
UpdateNetMailFlag;
END;
PROCEDURE UpdateNetMailFlag;
VAR
s : S9;
HaveNetMail : Boolean;
f : FILE OF Word;
HighMsg : Word;
Sr : SearchRec;
BEGIN
HaveNetMail:=False;
IF Cfg.MailScanner.NetMailDir<>'' THEN
BEGIN
FindFirst(Cfg.MailScanner.NetMailDir+'LASTREAD.*', Archive, Sr);
IF DOSError=0 THEN
BEGIN
Assign(f, Cfg.MailScanner.NetMailDir+Sr.Name);
FileMode:=ShareRead+ShareDenyNone;
Reset(f);
IF IOResult=0 THEN
BEGIN
Read(f, HighMsg); IF IOResult=0 THEN ;
Close(f);
HaveNetMail:=(GetHighestMsg(Cfg.MailScanner.NetMailDir)>HighMsg);
END;
END;
FindClose(Sr);
END;
IF HaveNetMail THEN
s:=' NetMail '
ELSE
IF InLogWin THEN s:='═════════' ELSE s:='─────────';
ActivityWindow^.ActivateWrite;
ActivityWindow^.ChangeHeader(2, s);
ActivityWindow^.DeActivateWrite;
END;
FUNCTION WaitForAction(Secs: LongInt): Word;
VAR
t: EventTimer;
InKey:WORD;
BEGIN
InKey:=0;
NewTimerSecs(t, Secs);
REPEAT
GiveUpTime;
UNTIL PoPKeyPressed OR ComPort^.KeyPressed OR (TimerExpired(t));
IF (NOT ComPort^.KeyPressed) AND (PopKeyPressed) THEN InKey:=PopReadKeyWord;
WaitForAction:=InKey;
END;
FUNCTION CorrectAttribute(Level:Byte; Current,Marked:Boolean):Byte;
BEGIN
WITH cfg.color[Level] DO
BEGIN
IF Current THEN
BEGIN
IF Marked THEN CorrectAttribute:=HighLightColor
ELSE CorrectAttribute:=BlockColor;
END ELSE
BEGIN
IF Marked THEN CorrectAttribute:=SelFieldColor
ELSE CorrectAttribute:=FieldColor;
END;
END;
END;
FUNCTION SendableData(OutListPtr: POutList): Boolean;
VAR
s : Boolean;
BaudRate : Word;
BEGIN
WITH OutListPtr^, CurrentEvent DO
BEGIN
IF (NC>=tries.busy) OR (BWZ>=tries.bad) OR (Closed) OR
((MinMail>0) AND (Size<MinMail)) OR (DontCall) THEN
s:=False
ELSE
BEGIN
IF Cfg.Modem.BaudRate<Baud THEN BaudRate:=Cfg.Modem.BaudRate
ELSE BaudRate:=Baud;
IF ((MaxCost>0) AND (Cost>MaxCost)) THEN
BEGIN
s:=False;
END ELSE
BEGIN
s:=(Bits AND 8)<>0; { Important }
IF typ AND etReceive=0 THEN { Receive only }
BEGIN { Crash }
s:=s OR (((Bits AND 4)<>0) AND ((Not NoCMail) OR (TimeIsBetween(OpenFrom, OpenTo)) OR
((Address.Zone=Cfg.Addresses[Cfg.MainAdrNum].Zone) AND (Cfg.ZMHStart+Cfg.ZMHEnd>0) AND
TimeIsBetween(Cfg.ZMHStart,Cfg.ZMHEnd))));
IF (typ AND etCrash=0) THEN
s:=s OR ((((Bits AND 1)<>0) OR ((Bits AND 2)<>0)) AND
((Not NoCMail) OR (TimeIsBetween(OpenFrom,OpenTo)) OR
((Address.Zone=Cfg.Addresses[Cfg.MainAdrNum].Zone) AND (Cfg.ZMHStart+Cfg.ZMHEnd>0)) AND
TimeIsBetween(Cfg.ZMHStart,Cfg.ZMHEnd)));
END;
END;
END;
IF (Baud>Cfg.Modem.BaudRate) AND (NOT Cfg.FastCalls) THEN s:=False;
SendableData:=s AND Not Glued;
END;
END;
PROCEDURE UpdateOutboundWindow;
VAR
b : WORD;
s : String;
Send : Char;
Attr, i : Byte;
OutListPtr : POutList;
OkToWrite : Boolean;
FUNCTION Star(B: Byte): Char;
BEGIN
IF (OutListPtr^.Bits AND B)<>0 THEN Star:='*' ELSE Star:=' ';
END;
BEGIN
OutboundWindow^.ActivateWrite;
OutListPtr:=POutList(OutList^.Head);
MailToSend:=False;
OkToWrite:=False;
i:=0; Send:=' ';
REPEAT
IF OutListPtr=FLOutListPtr THEN OkToWrite:=True;
IF OkToWrite THEN INC(i);
IF OutListPtr<>Nil THEN
BEGIN
IF OutListPtr=CLOutListPtr THEN Attr:=Cfg.Color[1].BlockColor
ELSE Attr:=Cfg.Color[1].HighLightColor;
WITH OutListPtr^, CurrentEvent DO
BEGIN
IF Not Known THEN Send:='?' ELSE
IF Closed THEN Send:=#25 ELSE
BEGIN
IF (NC>=tries.busy) OR (BWZ>=tries.bad) THEN Send:='!' ELSE
IF Glued THEN Send:=#1 ELSE
IF SendableData(OutListPtr) THEN Send:='*' ELSE Send:='-';
END;
IF OkToWrite AND (i<5) THEN
BEGIN
s:=Address2Str(Address);
IF Baud<Cfg.Modem.BaudRate THEN b:=baud ELSE b:=Cfg.Modem.BaudRate;
s:=CPad(s,19)+Send+' '+Star(8)+Star(4)+Star(2)+Star(1)+Star(16)+' '+
Star(32)+' '+Star(64)+' '+Star(128)+' '+LongIntForm('###',FilesToSend)+
' '+LongIntForm('###', Age)+' '+LongIntForm('#####',(Size+512) DIV 1024);
IF (Send<>'?') AND (b<>0) THEN
BEGIN
s:=s+' '+TimeToTimeString('h:mm:ss',Trunc(Size DIV 230*2400 DIV b));
END ELSE
s:=s+' ';
OutboundWindow^.wFastWrite(s,i+1,2,Attr);
END;
END;
OutListPtr:=POutList(OutList^.Next(OutListPtr));
END ELSE
IF i<5 THEN OutboundWindow^.wFastWrite(CharStr(' ',55),i+1,2,Cfg.Color[1].HighLightcolor);
IF Send='*' THEN MailToSend:=True;
UNTIL (OutListPtr=NIL) AND (i>4);
OutboundWindow^.DeActivateWrite;
END;
PROCEDURE UpdateCallsWindow(w:WindowPtr; n:Byte);
VAR
t1,i : Byte;
S : String;
BEGIN
FOR t1:=1 TO 5 DO
WITH Data.Calls[n,t1] DO
IF Adr.Zone<>0 THEN
BEGIN
IF Adr.Zone=-1 THEN
s:=CharStr(' ',14)
ELSE
s:=CPad(Address2Str(Adr),14);
s:=s+CPad(Name,17)+TimeToTimeString('HH:mM',T);
IF ScreenHeight<=LinesForStat THEN i:=2 ELSE i:=1;
w^.wFastWrite(s,t1,2,Cfg.color[i].HighlightColor);
END;
END;
PROCEDURE AboutToday;
VAR
Temp,
userwin : WindowPtr;
t : LongInt;
D : Word;
PROCEDURE WriteLine(t1,t2: Word; t3: LongInt; y: Byte);
BEGIN
Temp^.wFastWrite(LongIntForm('#####',t1)+
LongIntForm('#######',t2)+
LongIntForm('############',t3)+
LongIntForm('#######',t3 DIV D),
y,16,Cfg.Color[2].HighLightColor);
END;
BEGIN
MyWin(UserWin, 17, ScreenHeight-23-Byte(ScreenHeight>LinesForStat)*2, 63,
ScreenHeight-17-Byte(ScreenHeight>LinesForStat)*2, 2, 'Last users',False);
WITH UserWin^, cfg.color[2] DO
FOR t:=1 TO 5 DO
IF data.users[t].Name <> '' THEN
BEGIN
wfastwrite(data.users[t].Name, t, 2, HighLightColor);
wfastwrite(TimeToTimeString('HH:mM',data.users[t].T), t, 40, HighLightColor);
END;
MyWin(Temp, 15, ScreenHeight-16-Byte(ScreenHeight>LinesForStat)*2, 65,
ScreenHeight-7-Byte(ScreenHeight>LinesForStat)*2, 2, 'Activity report',False);
WITH Temp^, cfg.color[2] DO
BEGIN
wFastText('Today Yesterday Total Average',1,16);
wfastText('User calls :', 2, 2);
wfastText('Mail calls :', 3, 2);
wfastText('Calls out :', 4, 2);
wfastText('Successes :', 5, 2);
wfastText('Call cost :', 6, 2);
wfastText('Files in :', 7, 2);
wfastText('Files out :', 8, 2);
END;
IF StatRec^.Start.D<>0 THEN
BEGIN
D:=Today-StatRec^.Start.D;
Temp^.wFastWrite('('+DateToDateString('dd/mm-yy',StatRec^.Start.D)+')',1,3,Cfg.Color[2].HighlightColor);
END ELSE
D:=1;
IF D=0 THEN D:=1;
WITH StatRec^ DO
BEGIN
WriteLine(DayStat[0].bbssessions,DayStat[1].BbsSessions,Total.BBSSessions,2);
WriteLine(DayStat[0].mailsessions,DayStat[1].MailSessions,Total.MailSessions,3);
WriteLine(DayStat[0].callsout,DayStat[1].CallsOut,Total.CallsOut,4);
WriteLine(DayStat[0].callsgood,DayStat[1].CallsGood,Total.CallsGood,5);
WriteLine(DayStat[0].Cost,DayStat[1].Cost,Total.Cost,6);
WriteLine(DayStat[0].filesin,DayStat[1].FilesIn,Total.FilesIn,7);
WriteLine(DayStat[0].filesout,DayStat[1].FilesOut,Total.FilesOut,8);
END;
IF ScreenHeight<=LinesForStat THEN MyWin(CallsIn, 1, ScreenHeight-6, 40, ScreenHeight, 2, 'Last calls in', False);
UpdateCallsWindow(CallsIn, 1);
IF ScreenHeight<=LinesForStat THEN MyWin(CallsOut, 41, ScreenHeight-6, 80, ScreenHeight, 2, 'Last calls out', False);
UpdateCallsWindow(CallsOut, 2);
WaitForAction(20);
IF ScreenHeight<=LinesForStat THEN
BEGIN
KillWindow(CallsOut);
KillWindow(CallsIn);
END;
KillWindow(Temp);
KillWindow(UserWin);
END;
PROCEDURE UpdateStatusWindow;
VAR
s : String;
BEGIN
WITH StatusWindow^ DO
BEGIN
ActivateWrite;
wfastwrite(LongIntForm('##',data.event)+' ',3,11,Cfg.Color[1].HighLightColor);
s:=LongIntForm('##',cfg.modem.commport)+',';
IF ComPort^.Carrier THEN
s:=s+LongIntForm('#####',ComPort^.GetBaudRate)
ELSE
s:=s+LongIntForm('#####',Cfg.Modem.BaudRate);
wFastWrite(s,4,11,Cfg.Color[1].HighLightColor);
wFastWrite(CharStr(' ',8),5,11,Cfg.Color[1].HighLightColor);
END;
s:='';
IF Data.Event>0 THEN
BEGIN
WITH CurrentEvent DO
BEGIN
IF typ AND etRequests<>0 THEN s:=s+'R';
IF typ AND etUsers<>0 THEN s:=s+'U' ELSE s:=s+'M';
IF typ AND etReceive<>0 THEN s:=s+'Ro';
IF typ AND etCrash<>0 THEN s:=s+'Co';
IF typ AND etNoSend<>0 THEN s:=s+'Ns';
IF typ AND etDynamic<>0 THEN s:=s+'D';
END;
END ;
StatusWindow^.wFastWrite(s,5,11,Cfg.Color[1].HighLightColor);
StatusWindow^.DeActivateWrite;
END;
END.